Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/xceedzip/FRMFILTE.FRM

Visual Basic Form | 1999-04-26 | 17.5 KB | 434 lines

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.1#0"; "COMCTL32.OCX"
Object = "{C932BA88-4374-101B-A56C-00AA003668DC}#1.1#0"; "MSMASK32.OCX"
Begin VB.Form frmFilters
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Filters..."
   ClientHeight    =   3255
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8340
   Icon            =   "frmFilters.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3255
   ScaleWidth      =   8340
   StartUpPosition =   1  'CenterOwner
   Begin VB.Frame fraAttributes
      Caption         =   "Limit processing based on file attributes:"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2535
      Left            =   3850
      TabIndex        =   13
      Top             =   120
      Width           =   4350
      Begin ComctlLib.ListView lstExcludedAttributes
         Height          =   1935
         Left            =   2250
         TabIndex        =   2
         Top             =   480
         Width           =   1935
         _ExtentX        =   3413
         _ExtentY        =   3413
         View            =   3
         Arrange         =   1
         LabelEdit       =   1
         MultiSelect     =   -1  'True
         LabelWrap       =   -1  'True
         HideSelection   =   -1  'True
         HideColumnHeaders=   -1  'True
         _Version        =   327680
         ForeColor       =   -2147483640
         BackColor       =   -2147483643
         BorderStyle     =   1
         Appearance      =   1
         MouseIcon       =   "frmFilters.frx":030A
         NumItems        =   1
         BeginProperty ColumnHeader(1) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
            Key             =   ""
            Object.Tag             =   ""
            Text            =   "Attribute"
            Object.Width           =   2540
         EndProperty
      End
      Begin ComctlLib.ListView lstRequiredAttributes
         Height          =   1935
         Left            =   120
         TabIndex        =   1
         Top             =   480
         Width           =   1935
         _ExtentX        =   3413
         _ExtentY        =   3413
         View            =   3
         Arrange         =   1
         LabelEdit       =   1
         MultiSelect     =   -1  'True
         LabelWrap       =   -1  'True
         HideSelection   =   -1  'True
         HideColumnHeaders=   -1  'True
         _Version        =   327680
         ForeColor       =   -2147483640
         BackColor       =   -2147483643
         BorderStyle     =   1
         Appearance      =   1
         MouseIcon       =   "frmFilters.frx":0326
         NumItems        =   1
         BeginProperty ColumnHeader(1) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
            Key             =   ""
            Object.Tag             =   ""
            Text            =   "Attribute"
            Object.Width           =   2769
         EndProperty
      End
      Begin VB.Label lblExcludedAtrributes
         Caption         =   "These attributes must be off:"
         Height          =   255
         Left            =   2250
         TabIndex        =   15
         Top             =   240
         Width           =   2055
      End
      Begin VB.Label lblRequiredAttributes
         Caption         =   "These attributes must be on:"
         Height          =   255
         Left            =   120
         TabIndex        =   14
         Top             =   240
         Width           =   2055
      End
   End
   Begin VB.Frame fraSize
      Caption         =   "Limit processing by a file's size:"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1170
      Left            =   120
      TabIndex        =   8
      Top             =   1485
      Width           =   3615
      Begin VB.TextBox txtMinSizeToProcess
         Height          =   285
         Left            =   1560
         TabIndex        =   16
         Top             =   360
         Width           =   1095
      End
      Begin VB.TextBox txtMaxSizeToProcess
         Height          =   278
         Left            =   1560
         TabIndex        =   0
         Top             =   765
         Width           =   1095
      End
      Begin VB.Label lblk2
         Caption         =   "K"
         Height          =   240
         Left            =   2760
         TabIndex        =   12
         Top             =   795
         Width           =   135
      End
      Begin VB.Label lblk1
         Caption         =   "K"
         Height          =   240
         Left            =   2760
         TabIndex        =   11
         Top             =   390
         Width           =   255
      End
      Begin VB.Label lblMaxSizeToProcess
         Caption         =   "Maximum size:"
         Height          =   255
         Left            =   360
         TabIndex        =   10
         Top             =   765
         Width           =   1215
      End
      Begin VB.Label lblMinSizeToProcess
         Caption         =   "Minimum size:"
         Height          =   255
         Left            =   360
         TabIndex        =   9
         Top             =   360
         Width           =   1095
      End
   End
   Begin VB.Frame fraDates
      Caption         =   "Limit processing based on a file's date:"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1170
      Left            =   120
      TabIndex        =   4
      Top             =   120
      Width           =   3615
      Begin MSMask.MaskEdBox mebMaxDateToProcess
         Height          =   285
         Left            =   1560
         TabIndex        =   17
         Top             =   765
         Width           =   1095
         _ExtentX        =   1931
         _ExtentY        =   503
         _Version        =   327680
         PromptChar      =   "#"
      End
      Begin MSMask.MaskEdBox mebMinDateToProcess
         Height          =   285
         Left            =   1560
         TabIndex        =   18
         Top             =   360
         Width           =   1095
         _ExtentX        =   1931
         _ExtentY        =   503
         _Version        =   327680
         ClipMode        =   1
         HideSelection   =   0   'False
         Format          =   "c"
         PromptChar      =   "_"
      End
      Begin VB.Label lblMaxDateToProcess
         Caption         =   "Maximum date:"
         Height          =   255
         Left            =   360
         TabIndex        =   7
         Top             =   765
         Width           =   1215
      End
      Begin VB.Label lblMinDateToProcess
         Caption         =   "Minimum date:"
         Height          =   255
         Left            =   360
         TabIndex        =   6
         Top             =   360
         Width           =   1095
      End
   End
   Begin VB.CommandButton cmdOk
      Caption         =   "&OK"
      Height          =   375
      Left            =   5900
      TabIndex        =   3
      Top             =   2790
      Width           =   1095
   End
   Begin VB.CommandButton cmdCancel
      Cancel          =   -1  'True
      Caption         =   "&Cancel"
      Height          =   375
      Left            =   7115
      TabIndex        =   5
      Top             =   2790
      Width           =   1095
   End
Attribute VB_Name = "frmFilters"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'=============================================================================
' Description: The frmFilters form lets the user limit the processing of files
'              to files matching certain criteria such as file date, file size,
'              and file attributes.
'=============================================================================
'------------------------------------------------------------------------------------
' Validates the dates entered into the form's controls
'------------------------------------------------------------------------------------
Private Function CheckDates() As Boolean
    Dim ValidDate As Date
    On Error Resume Next
    ValidDate = CDate(mebMinDateToProcess.Text)
    ValidDate = CDate(mebMaxDateToProcess.Text)
    If Err > 0 Then
        CheckDates = False
    Else
        CheckDates = True
    End If
End Function
'------------------------------------------------------------------------------------
' Initializes the form's listboxes with xZip's property values
'--------------------------------------------------------------------------------
Private Sub InitializeForm(xZip As XceedZip)
    Dim counter As Integer
    ' Load the minimum and maximum size to process onto the form's controls
    txtMinSizeToProcess.Text = Val(xZip.MinSizeToProcess) / 1024
    txtMaxSizeToProcess.Text = Val(xZip.MaxSizeToProcess) / 1024
    ' Set the RequiredFileAttributes and ExcludedFileAttributes in the lists
    For counter = 1 To lstRequiredAttributes.ListItems.Count
        lstRequiredAttributes.ListItems(counter).Selected = _
            ((xZip.RequiredFileAttributes And Val(lstRequiredAttributes.ListItems(counter).Tag)) > 0)
    Next counter
    For counter = 1 To lstExcludedAttributes.ListItems.Count
        lstExcludedAttributes.ListItems(counter).Selected = _
            ((xZip.ExcludedFileAttributes And Val(lstExcludedAttributes.ListItems(counter).Tag)) > 0)
    Next counter
    ' Reads and formats the dates as defined by the current
    ' operating system settings
    mebMinDateToProcess.Text = Format(xZip.MinDateToProcess, "General Date")
    mebMaxDateToProcess.Text = Format(xZip.MaxDateToProcess, "General Date")
    ' Loads the "mouseover tips" so the user can easily see the
    ' system's date format.
    Call LoadDateTips
End Sub
'------------------------------------------------------------------------------------
' Places the tooltiptext which shows the user the system's date format
'------------------------------------------------------------------------------------
Private Sub LoadDateTips()
    Dim dateFormat As String
    dateFormat = Format("2039-12-27", "General Date")
    mebMaxDateToProcess.ToolTipText = "Format is " + dateFormat
    mebMinDateToProcess.ToolTipText = "Format is " + dateFormat
End Sub
'------------------------------------------------------------------------------------
'Initializes the required and excluded file attributes listboxes
'------------------------------------------------------------------------------------
Private Sub Loadlistboxes(xZip As XceedZip)
    lstRequiredAttributes.ListItems.Clear
    lstExcludedAttributes.ListItems.Clear
    Dim archive As ListItem
    Set archive = lstRequiredAttributes.ListItems.Add(, , "Archive")
    archive.Tag = xfaArchive
    Set archive = lstRequiredAttributes.ListItems.Add(, , "Folder")
    archive.Tag = xfaFolder
    Set archive = lstRequiredAttributes.ListItems.Add(, , "Hidden")
    archive.Tag = xfaHidden
    Set archive = lstRequiredAttributes.ListItems.Add(, , "Read-Only")
    archive.Tag = xfaReadOnly
    Set archive = lstRequiredAttributes.ListItems.Add(, , "System")
    archive.Tag = xfaSystem
    Set archive = lstRequiredAttributes.ListItems.Add(, , "Volume")
    archive.Tag = xfaVolume
    Set archive = lstRequiredAttributes.ListItems.Add(, , "Compressed")
    archive.Tag = xfaCompressed
    Set archive = lstExcludedAttributes.ListItems.Add(, , "Archive")
    archive.Tag = xfaArchive
    Set archive = lstExcludedAttributes.ListItems.Add(, , "Folder")
    archive.Tag = xfaFolder
    Set archive = lstExcludedAttributes.ListItems.Add(, , "Hidden")
    archive.Tag = xfaHidden
    Set archive = lstExcludedAttributes.ListItems.Add(, , "Read-Only")
    archive.Tag = xfaReadOnly
    Set archive = lstExcludedAttributes.ListItems.Add(, , "System")
    archive.Tag = xfaSystem
    Set archive = lstExcludedAttributes.ListItems.Add(, , "Volume")
    archive.Tag = xfaVolume
    Set archive = lstExcludedAttributes.ListItems.Add(, , "Compressed")
    archive.Tag = xfaCompressed
End Sub
'------------------------------------------------------------------------------------
' Opens up the frmFilters form
'------------------------------------------------------------------------------------
Public Function ShowForm(xZip As XceedZip) As Boolean

    ' Initialise the form's tag, which is used later to determine
    ' if the OK button was pressed to accept the changes
    frmFilters.Tag = "0"
    'Loads the required and excluded attributes listboxes
    Call Loadlistboxes(xZip)

    ' Loads the xZip object's property values into the frmFilters
    ' form's controls
    Call InitializeForm(xZip)

    ' Shows the form
    frmFilters.Show vbModal

    ' If tag = "1" then the user clicked on Ok and the form's controls
    ' values are copied in the xZip properties
    If frmFilters.Tag = "1" Then
        Call UpdateDataToxZip(xZip)
    End If

    ' If tag = "1" then the user clicked on OK and the procedure returns TRUE
    ShowForm = (frmFilters.Tag = "1")
End Function
'------------------------------------------------------------------------------------
'Forces the user to enter numerical caracters in the MaxSizeToProgress
'textbox.
'------------------------------------------------------------------------------------
Private Sub txtMaxSizeToProcess_KeyPress(KeyAscii As Integer)
    KeyAscii = ValidateNumbers(KeyAscii)
End Sub
'------------------------------------------------------------------------------------
'Forces the user to enter numerical caracters in the MinSizeToProgress
'textbox.
'------------------------------------------------------------------------------------
Private Sub txtMinSizeToProcess_KeyPress(KeyAscii As Integer)
    KeyAscii = ValidateNumbers(KeyAscii)
End Sub
'------------------------------------------------------------------------------------
'Sets the xZip object's properties according to the settings
'of the form's controls
'------------------------------------------------------------------------------------
Private Function UpdateDataToxZip(xZip As XceedZip)
    Dim counter As Integer
    'Set the MinSizeToProcess and MaxSizeToProcess properties...
    xZip.MinSizeToProcess = Val(txtMinSizeToProcess.Text) * 1024
    xZip.MaxSizeToProcess = Val(txtMaxSizeToProcess.Text) * 1024
    'Set the RequiredFileAttributes property...
    xZip.RequiredFileAttributes = xfaNone
    xZip.ExcludedFileAttributes = xfaNone
    For counter = 1 To lstRequiredAttributes.ListItems.Count
        If lstRequiredAttributes.ListItems(counter).Selected Then
            xZip.RequiredFileAttributes = xZip.RequiredFileAttributes + Val(lstRequiredAttributes.ListItems(counter).Tag)
        End If
    Next counter
    'Set the ExcludedFileAttributes property...
    For counter = 1 To lstExcludedAttributes.ListItems.Count
        If lstExcludedAttributes.ListItems(counter).Selected Then
             xZip.ExcludedFileAttributes = xZip.ExcludedFileAttributes + Val(lstExcludedAttributes.ListItems(counter).Tag)
        End If
    Next counter
    'Set the MinDateToProcess and MaxDateToProcess properties
    xZip.MinDateToProcess = CDate(mebMinDateToProcess.Text)
    xZip.MaxDateToProcess = CDate(mebMaxDateToProcess)
End Function
'------------------------------------------------------------------------------------
' The user clicked on Cancel and tag stays at "0"
'------------------------------------------------------------------------------------
Private Sub cmdCancel_Click()
    Me.Hide
End Sub
'------------------------------------------------------------------------------------
' The user clicked on OK and the dates are validated. If they do not fit the
' system's default date format, a message box alerts the user to change the
' dates and the tag stays at "0". If the dates are correct, the tag receives
' the "1" value, indicating that the changes should be accepted.
'------------------------------------------------------------------------------------
Private Sub cmdOk_Click()
    Dim bDateValid      As Boolean
    Dim sDateFormat     As String
    bDateValid = CheckDates()
    If bDateValid = False Then
        sDateFormat = Format("2039-12-27", "General Date")
        MsgBox "Date values are invalid. The format is " + sDateFormat, vbExclamation
    Else
        Me.Tag = "1"
        Me.Hide
    End If
End Sub